~VERSION = 3.00 _table2.h&#_navmenu _table2.hPixelsClass3 _container_navmenu_navmenuoNavcustomoMenu!Arial, 0, 9, 5, 15, 12, 21, 3, 0  _locatebuttonPixelsClass1 _dialogbutton _locatebutton commandbutton _table2.vcx!Arial, 0, 9, 5, 15, 12, 21, 3, 0  _gotobuttonPixelsClass1)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 _gotoPixelsClass3 _container_goto zc%+sWU H  CCC 1B CXTCO CWxB2TCOUTHISPARENT CUSTABLENAVCALIASVALUECUTHISPARENTGORECORDRefresh,InteractiveChange1AAA21& Nd )_gotospnGoTospinner _base.vcx_spinner+Top = 24 Left = 48 Name = "cusTableNav" !Arial, 0, 9, 5, 15, 12, 21, 3, 0  _sortselectPixelsClass)MS Sans Serif, 1, 9, 6, 13, 11, 12, 2, 0 _nav2picbuttonsPixelsClass1 _nav2buttons_nav2picbuttons container _table.vcx4 _container _sortselect_goto cusTableNavcustom _sortselect _base.vcx _table.vcx _tablenavT*gorecord Goes to specified record in spinner. *initdata Initializes data source. 9 %ZoiUCaUTHISPARENTDOSORTClick,11()3PROCEDURE Click THIS.Parent.DoSort(.T.) ENDPROC  cmdSortDown _sortselectFontName = "MS Sans Serif" FontSize = 8 Height = 22 Increment = 1.00 InputMask = "9999999999" Left = 0 Top = 0 Width = 84 Format = "" Name = "spnGoTo"  container _base.vcx8Pixels:Width = 84 Height = 22 BorderWidth = 0 Name = "_goto" _tbrnavigationPixels _dialogbutton _gotobutton commandbutton _table2.vcx1PROCEDURE Init LOCAL llReturn llReturn = DODEFAULT() IF llReturn THIS.cAlias = THIS.GetCurrentAlias() ENDIF RETURN llReturn ENDPROC kArial, 1, 9, 6, 15, 12, 32, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Arial, 0, 9, 5, 15, 12, 32, 3, 0  Width = 71 Height = 36 Name = "_nav2picbuttons" cmgNav.Command1.AutoSize = .F. cmgNav.Command1.Top = 5 cmgNav.Command1.Left = 5 cmgNav.Command1.Height = 24 cmgNav.Command1.Width = 24 cmgNav.Command1.Picture = graphics\previous.bmp cmgNav.Command1.Caption = "" cmgNav.Command1.ToolTipText = "Previous Record" cmgNav.Command1.Name = "Command1" cmgNav.Command2.AutoSize = .F. cmgNav.Command2.Top = 5 cmgNav.Command2.Left = 29 cmgNav.Command2.Height = 24 cmgNav.Command2.Width = 24 cmgNav.Command2.Picture = graphics\next.bmp cmgNav.Command2.Caption = "" cmgNav.Command2.ToolTipText = "Next Record" cmgNav.Command2.Name = "Command2" cmgNav.Height = 34 cmgNav.Left = 8 cmgNav.Top = 0 cmgNav.Width = 57 cmgNav.Name = "cmgNav" cusTableNav.Name = "cusTableNav"  commandbutton cmdSortUpoPROCEDURE Refresh DO CASE CASE EMPTY(THIS.Parent.cusTableNav.cAlias) AND EMPTY(ALIAS()) RETURN CASE EMPTY(THIS.Parent.cusTableNav.cAlias) THIS.Value = RECNO() CASE SELECT(THIS.Parent.cusTableNav.cAlias)=0 RETURN OTHERWISE THIS.Value = RECNO(THIS.Parent.cusTableNav.cAlias) ENDCASE ENDPROC PROCEDURE InteractiveChange THIS.Parent.GoRecord() ENDPROC  %UE TC %5TC BULLRETURNTHISCALIASGETCURRENTALIASInit,1qAA1) %uOU,CCUTHIS CUSTABLENAV GOTORECORDSPNGOTOVALUEREFRESHLASTWINDOWAFTERCHANGE8%C C CN J T-J(JCN(T COT C F BU LLRETURNTHIS CUSTABLENAVCALIASSPNGOTOSPINNERLOWVALUEKEYBOARDLOWVALUESPINNERHIGHVALUEKEYBOARDHIGHVALUEVALUE CUTHISINITDATAgorecord,initdataInit13q1aQAA31  +)Class_toolbar_tbrnavigationTop = 3 Left = 263 Height = 22 Width = 23 Picture = graphics\find.bmp Caption = "" ToolTipText = "Locate..." Name = "cmdLocate" _tbrnavigation cmdLocate commandbutton _table2.vcx _locatebuttonTop = 3 Left = 241 Height = 22 Width = 23 Picture = graphics\filter.bmp Caption = "" ToolTipText = "Set Filter..." Name = "cmdFilter" _tbrnavigation cmdFilter commandbutton _table2.vcx _filterbuttonTop = 3 Left = 196 Width = 46 Height = 22 Name = "_sortselect" cusTableSort.Name = "cusTableSort" cmdSortUp.Name = "cmdSortUp" cmdSortDown.Name = "cmdSortDown" _tbrnavigation _sortselect _sortdialog_commandbutton0PROCEDURE Click THIS.Parent.DoSort() ENDPROC  commandbutton _base.vcx_commandbutton _sortselectcustom container _table2.vcx _sortselect_tbrnavigation Separator1 separator _table2.h2# cusTableSortPixels _table.vcxOTop = 3 Left = 196 Height = 55249180 Width = 55249180 Name = "Separator1"  separatoraTop = 3 Left = 105 Name = "_goto" cusTableNav.Name = "cusTableNav" spnGoTo.Name = "spnGoTo" _tbrnavigation_goto container _table2.vcx_gotoOTop = 3 Left = 105 Height = 30742164 Width = 30742164 Name = "Separator2" _tbrnavigation Separator2 separator separator_tbrnavigation_nav4picbuttons container _table2.vcxClassJArial, 0, 9, 5, 15, 12, 21, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0  _table2.hClassform _sortdialog _sortdialogClass ]i%UJ%C CC )B C CUTCACTIONTHISFORMREFRESHtablenav,1qAA1),Top = 72 Left = 48 Name = "cusTableSort"  cusTableSortcustom _table.vcx _tablesortAutoSize = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "Select field:" Left = 16 Top = 12 TabIndex = 6 Name = "_label2"  _sortdialog_label2label _base.vcx_labelAutoSize = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "Sort direction:" Left = 236 Top = 12 TabIndex = 5 Name = "_label1"  _sortdialog_label1label _base.vcx_label _sortdialog cmdCancel$ _table2.h*ldisabledformodal calias Current alias.  _base.vcx _dialogbutton*dosort Runs sort routine.  _base.vcxqPROCEDURE dodialog THIS.cClass = IIF(THIS.lExprDialog,THIS.cExprClass,THIS.cFilterClass) DODEFAULT() ENDPROC  commandbutton _dialogbutton_commandbutton _table2.vcx commandbuttonCCaption = "\U_ %CRecord#&G((X*CCUTHIS_CBOTAGSVALUE CUSTABLESORTDOSORT OPGDIRECTIONR%CCB-+%CTHIS._cboTags.BaseclassbCKB-Udosort,Init1aA3qAqA1- )Top = 3 Left = 5 Width = 93 Height = 22 Name = "_nav4picbuttons" cmgNav.Command1.Top = 0 cmgNav.Command1.Left = 16 cmgNav.Command1.Height = 22 cmgNav.Command1.Width = 23 cmgNav.Command1.Name = "Command1" cmgNav.Command2.Top = 0 cmgNav.Command2.Left = 39 cmgNav.Command2.Height = 22 cmgNav.Command2.Width = 23 cmgNav.Command2.Name = "Command2" cmgNav.BorderStyle = 0 cmgNav.Name = "cmgNav" cusTableNav.Top = 5 cusTableNav.Left = 68 cusTableNav.Height = 13 cusTableNav.Width = 17 cusTableNav.Name = "cusTableNav" cmdTop.Top = 0 cmdTop.Left = 1 cmdTop.Height = 22 cmdTop.Width = 23 cmdTop.Name = "cmdTop" cmdBottom.Top = 0 cmdBottom.Left = 70 cmdBottom.Height = 22 cmdBottom.Width = 23 cmdBottom.Name = "cmdBottom" PROCEDURE dodialog LOCAL lcfile, lcclass, lnModal IF !EMPTY(THIS.cClasslib) lcfile = FULLPATH(THIS.cClasslib) ELSE lcfile = FULLPATH(THIS.ClassLibrary) ENDIF IF NOT FILE(lcfile) WAIT WINDOW ERR_NOVCXLIB_LOC RETURN .F. ENDIF lcclass = THIS.cClass IF EMPTY(lcclass) WAIT WINDOW ERR_NOCLASS_LOC RETURN .F. ENDIF IF EMPTY(THIS.cParms) AND VARTYPE(THIS.cParms)="C" THIS.oDialog = NEWOBJECT(lcclass,lcfile) ELSE THIS.oDialog = NEWOBJECT(lcclass,lcfile,"",THIS.cParms) ENDIF IF VARTYPE(THIS.oDialog)="O" lnModal = IIF(THIS.lModal,1,0) THIS.SetDialogPEMs() &&abstract method THIS.oDialog.Show(lnModal) ENDIF ENDPROC PROCEDURE Click THIS.DoDialog() ENDPROC PROCEDURE Destroy THIS.oDialog=null ENDPROC  PROCEDURE domenu IF EMPTY(ALIAS()) RETURN ENDIF PRIVATE oTHIS oTHIS = THIS THIS.oMenu.showmenu() THIS.RefreshForm() ENDPROC PROCEDURE setmenu LOCAL oGoMenu oGoMenu = THIS.oMenu.NewMenu() WITH oGoMenu .AddMenuBar(MENU_TOP_LOC,"oTHIS.oNav.GoTop()") .AddMenuBar(MENU_BOTTOM_LOC,"oTHIS.oNav.GoBottom()") .AddMenuBar(MENU_NEXT_LOC,"oTHIS.oNav.GoNext()") .AddMenuBar(MENU_PREV_LOC,"oTHIS.oNav.GoPrevious()") .AddMenuBar(MENU_RECORD_LOC,"oTHIS.DoGoto") ENDWITH WITH THIS.oMenu .AddMenuBar(MENU_GOTO_LOC,oGoMenu) .AddMenuSeparator .AddMenuBar(MENU_ADD_LOC,"oTHIS.AddRecord") .AddMenuBar(MENU_DELETE_LOC,"oTHIS.DeleteRecord") .AddMenuSeparator .AddMenuBar(MENU_SORT_LOC,"oTHIS.DoSort") .AddMenuBar(MENU_FILTER_LOC,"oTHIS.DoFilter") .AddMenuBar(MENU_FILTER2_LOC,"oTHIS.DoFilter2") ENDWITH ENDPROC PROCEDURE dodialog LOCAL lcfile, loDialog, lcclass IF !EMPTY(THIS.cClasslib) lcfile = FULLPATH(THIS.cClasslib) ELSE lcfile = FULLPATH(THIS.ClassLibrary) ENDIF IF NOT FILE(lcfile) WAIT WINDOW ERR_NOVCXLIB_LOC RETURN .F. ENDIF lcclass = THIS.cClass IF EMPTY(lcclass) WAIT WINDOW ERR_NOCLASS_LOC RETURN .F. ENDIF loDialog = NEWOBJECT(lcclass,lcfile) loDialog.Show(1) ENDPROC PROCEDURE dosort THIS.cClass = "_sortdialog" THIS.cClassLib = THIS.ClassLibrary THIS.DoDialog() ENDPROC PROCEDURE dogoto THIS.cClass = "_gotodialog" THIS.cClassLib =IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_table.vcx" THIS.DoDialog() ENDPROC PROCEDURE dofilter THIS.cClass = "_filterdialog" THIS.cClassLib =IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_table.vcx" THIS.DoDialog() ENDPROC PROCEDURE dofilter2 THIS.cClass = "_filterexpr" THIS.cClassLib =IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_table.vcx" THIS.DoDialog() ENDPROC PROCEDURE addrecord APPEND BLANK THIS.RefreshForm() ENDPROC PROCEDURE deleterecord IF MESSAGEBOX(C_DELREC_LOC,MB_QUESTIONYESNO) = MB_ISYES DELETE SKIP IF EOF() GO BOTTOM ENDIF THIS.RefreshForm() ENDIF ENDPROC PROCEDURE refreshform IF VARTYPE(_SCREEN.ActiveForm)="O" _SCREEN.ActiveForm.Refresh ENDIF ENDPROC PROCEDURE Error LPARAMETERS nerror,cmethod,nline DO CASE CASE nError = 5 &&record out of range IF EOF() GO BOTTOM ELSE GO TOP ENDIF CASE nError = 1884 AND CURSORGETPROP("buffering")=1 * Uniqueness ID error MESSAGEBOX(ERR_UNIQUEKEY_LOC) CASE nError = 1884 IF MESSAGEBOX(ERR_UNIQUEKEY_LOC+" "+ERR_UNIQUEKEY2_LOC,36)=6 TABLEREVERT(.T.) ENDIF ENDCASE ENDPROC PROCEDURE Init THIS.SetMenu() ENDPROC  { { k % a UJ%CCB5 TC CUOTHISTHISOMENUSHOWMENU REFRESHFORM<TC (C\T _sortdialogT CUTHISCCLASS CCLASSLIB CLASSLIBRARYDODIALOGeT _gotodialog:TCCh CQFFC\6 _table.vcx CUTHISCCLASS CCLASSLIBDODIALOGgT _filterdialog:TCCh CQFFC\6 _table.vcx CUTHISCCLASS CCLASSLIBDODIALOGeT _filterexpr:TCCh CQFFC\6 _table.vcx CUTHISCCLASS CCLASSLIBDODIALOG CUTHIS REFRESHFORMj9%C"Do you wish to delete this record?$xcH %C+R#6 CUTHIS REFRESHFORM*%C9O# 9U ACTIVEFORMREFRESH@ H9 O %C+>#6K#)) \C buffering 6C*A unique key error violation has occurred.x \9k%C*A unique key error violation has occurred. !Would you like to revert changes?$x5 CaUNERRORCMETHODNLINE CUTHISSETMENUdomenu,setmenudodialog"dosortedogotodofilterd dofilter2 addrecord~ deleterecord refreshform+ErrornInit1AAr3qA!A!qA22!!AqAqA1313333Q3AAQAA3qA3QQAb!AA22 : Y"/B73_=7^C;~I? /OBRTKA_O] e_ w){ fPROCEDURE Init LOCAL lcfile, lcclass, lhastoolbar,i lhastoolbar = .F. * Check if toolbar already exists... FOR i = 1 TO _VFP.FORMS.COUNT IF UPPER(_VFP.FORMS[m.i].NAME)==UPPER(THIS.cClass) lhastoolbar = .T. EXIT ENDIF ENDFOR IF !EMPTY(THIS.cClasslib) lcfile = FULLPATH(THIS.cClasslib) ELSE lcfile = FULLPATH(THIS.ClassLibrary) ENDIF IF NOT FILE(lcfile) WAIT WINDOW ERR_NOVCXLIB_LOC RETURN .F. ENDIF lcclass = THIS.cClass IF EMPTY(lcclass) WAIT WINDOW ERR_NOCLASS_LOC RETURN .F. ENDIF THIS.oToolbar = NEWOBJECT(lcclass,lcfile) IF !m.lhastoolbar THIS.oToolbar.Show() ELSE THIS.oToolbar.Visible = .F. THIS.tmrCheckToolbar.Interval = 500 ENDIF ENDPROC PROCEDURE Destroy IF VARTYPE(THIS.oToolbar)="O" THIS.oToolbar.Name = SYS(2015) INKEY(.1) THIS.oToolbar.Release THIS.oToolbar = null ENDIF ENDPROC $PROCEDURE Refresh LOCAL lcDataSession IF NOT THIS.lDisabledForModal lcDataSession=SET("DataSession") IF TYPE("_screen.activeform.name")="C" SET DataSession TO _screen.activeform.DataSessionID ENDIF THIS.cAlias = ALIAS() STORE THIS.cAlias TO ; THIS._GoTo.cusTableNav.cAlias, ; THIS._Nav4picbuttons.cusTableNav.cAlias, ; THIS._SortSelect.cusTableSort.cAlias THIS.Setall("Enabled",NOT EMPTY(THIS.cAlias)) THIS._GoTo.InitData() DODEFAULT() SET DataSession TO lcDataSession ENDIF ENDPROC